home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / prlgbnc1.lha / Bench / unify.pl < prev    next >
Text File  |  1990-08-02  |  7KB  |  150 lines
  1. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2. % Copyright (C) 1990 Regents of the University of California.
  3. % All rights reserved.  This program may be freely used and modified for
  4. % non-commercial purposes provided this copyright notice is kept unchanged.
  5. % Written by Peter Van Roy as a part of the Aquarius project.
  6. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  7.  
  8. % Benchmark based on part of Aquarius Prolog compiler
  9. % Compiling unification into abstract machine code.
  10.  
  11. main :- main(X), write(X), nl.
  12.  
  13. main(Size) :- u(X, [1,Y], [X], Code), size(Code, 0, Size).
  14.  
  15. % Unify variable X with term T and write the result:
  16. u(X, T, In, Code) :- unify(X, T, In, _, Code, []).
  17.  
  18. % Unify the variable X with the term T, given that
  19. % In = set of variables initialized before the unification.
  20. % Returns the intermediate code for the unification and
  21. % Out = set of variables initialized after the unification.
  22. unify(X, T, In, Out) --> {\+in(X, In)}, !, uninit(X, T, In, Out).
  23. unify(X, T, In, Out) -->   {in(X, In)}, !,   init(X, T, In, Out, nonlast, _).
  24.  
  25. %**** Uninit assumes X has not yet been initialized:
  26. uninit(X, T, In, Out) --> {compound(T)}, !, [move(Tag^h, X)],
  27.         {termtag(T, Tag)}, unify_block(nonlast, T, _, In, Mid, _), {incl(X, Mid, Out)}.
  28. uninit(X, T, In, Out) --> {atomic(T)}, !, [move(tatm^T, X)], {incl(X, In, Out)}.
  29. uninit(X, T, In, Out) --> {var(T)}, !, unify_var(X, T, In, Out).
  30.  
  31. %**** Init assumes X has already been initialized:
  32. init(X, T, In, Out, Last, LLbls) --> {nonvar(T)}, !,
  33.         {termtag(T,Tag)}, [deref(X), switch(Tag,X,[trail(X) | Write],Read,fail)],
  34.         {unify_writemode(X, T, In,      Last, LLbls, Write, [])},
  35.         {unify_readmode(X, T, In, Out,       LLbls, Read, [])}.
  36. init(X, T, In, Out,    _,     _) --> {var(T)}, !, unify_var(X, T, In, Out).
  37.  
  38. %**** Unifying two variables together:
  39. unify_var(X, Y, In,  In) --> {  in(X, In),   in(Y, In)}, !, [unify(X,Y,fail)].
  40. unify_var(X, Y, In, Out) --> {  in(X, In), \+in(Y, In)}, !, [move(X,Y)], {incl(Y, In, Out)}.
  41. unify_var(X, Y, In, Out) --> {\+in(X, In),   in(Y, In)}, !, [move(Y,X)], {incl(X, In, Out)}.
  42. unify_var(X, Y, In, Out) --> {\+in(X, In), \+in(Y, In)}, !,
  43.         [move(tvar^h,X), move(tvar^h,Y), add(1,h), move(Y,[h-1])],
  44.         {incl(X, In, Mid), incl(Y, Mid, Out)}.
  45.  
  46. %**** Unify_readmode assumes X is a dereferenced nonvariable
  47. % at run-time and T is a nonvariable at compile-time.
  48. unify_readmode(X, T, In, Out, LLbls) --> {structure(T)}, !, [equal([X],tatm^(F/N),fail)],
  49.         {functor(T, F, N)}, unify_args(1, N, T, In, Out,  0, X, LLbls).
  50. unify_readmode(X, T, In, Out, LLbls) --> {cons(T)}, !,
  51.         unify_args(1, 2, T, In, Out, -1, X, LLbls).
  52. unify_readmode(X, T, In,  In,     _) --> {atomic(T)}, !, [equal(X,tatm^T,fail)].
  53.  
  54. unify_args(I, N, _, In,  In, _, _,         _) --> {I>N}, !.
  55. unify_args(I, N, T, In, Out, D, X, [ _ | LLbls]) --> {I=N}, !,
  56.         unify_arg(I, T, In, Out, D, X, last, LLbls). 
  57. unify_args(I, N, T, In, Out, D, X,     LLbls) --> {I<N}, !,
  58.         unify_arg(I, T, In, Mid, D, X, nonlast, _),
  59.         {I1 is I+1}, unify_args(I1, N, T, Mid, Out, D, X, LLbls).
  60.  
  61. unify_arg(I, T, In, Out, D, X, Last, LLbls) --> [move([X+ID],Y)],
  62.         {ID is I+D, incl(Y, In, Mid), arg(I, T, A)},
  63.         init(Y, A, Mid, Out, Last, LLbls).
  64.  
  65. %**** Unify_writemode assumes X is a dereferenced unbound
  66. % variable at run-time and T is a nonvariable at compile-time.
  67. unify_writemode(X, T, In, Last, LLbls) --> {compound(T)}, !, [move(Tag^h,[X])],
  68.         {termtag(T, Tag)}, unify_block(Last, T, _, In, _, LLbls).
  69. unify_writemode(X, T,  _,    _,     _) --> {atomic(T)}, !, [move(tatm^T,[X])].
  70.  
  71. %**** Generate a minimal sequence of moves to create T on the heap:
  72. unify_block(   last, T, Size, In,  In, [Lbl | _ ]) --> !, [add(Size,h), jump(Lbl)],
  73.         {size(T, 0, Size)}.
  74. unify_block(nonlast, T, Size, In, Out, [ _ | LLbls]) --> !, [add(Size,h)],
  75.         {size(T, 0, Size), Offset is -Size}, block(T, Offset, 0, In, Out, LLbls).
  76.  
  77. block(T, Inf, Outf, In, Out, LLbls) --> {structure(T)}, !, [move(tatm^(F/N), [h+Inf])],
  78.         {functor(T, F, N), Midf is Inf+N+1, S is Inf+1},
  79.         make_slots(1, N, T, S, Offsets, In, Mid),
  80.         block_args(1, N, T, Midf, Outf, Offsets, Mid, Out, LLbls).
  81. block(T, Inf, Outf, In, Out, LLbls) --> {cons(T)}, !,
  82.         {Midf is Inf+2},
  83.         make_slots(1, 2, T, Inf, Offsets, In, Mid),
  84.         block_args(1, 2, T, Midf, Outf, Offsets, Mid, Out, LLbls).
  85. block(T, Inf,  Inf, In,  In,    []) --> {atomic(T)}, !.
  86. block(T, Inf,  Inf, In,  In,    []) --> {var(T)}, !.
  87.  
  88. block_args(I, N, _, Inf,  Inf,    [], In,  In,          []) --> {I>N}, !.
  89. block_args(I, N, T, Inf, Outf, [Inf], In, Out, [Lbl | LLbls]) --> {I=N}, !, [label(Lbl)],
  90.         {arg(I, T, A)}, block(A, Inf, Outf, In, Out, LLbls).
  91. block_args(I, N, T, Inf, Outf, [Inf | Offsets], In,Out,LLbls) --> {I<N}, !,
  92.         {arg(I, T, A)}, block(A, Inf, Midf, In, Mid, _), {I1 is I+1},
  93.         block_args(I1, N, T, Midf, Outf, Offsets, Mid, Out, LLbls).
  94.  
  95. make_slots(I, N, _, _,            [], In,  In) --> {I>N}, !.
  96. make_slots(I, N, T, S, [Off | Offsets], In, Out) --> {I=<N}, !,
  97.         {arg(I, T, A)}, init_var(A, S, In),
  98.         {incl(A, In, Mid), make_word(A, Off, Word)}, [move(Word,[h+S])],
  99.         {S1 is S+1, I1 is I+1},
  100.         make_slots(I1, N, T, S1, Offsets, Mid, Out).
  101.  
  102. % Initialize first-time variables in write mode:
  103. init_var(V, I, In) --> {var(V), \+in(V, In)}, !, [move(tvar^(h+I),V)].
  104. init_var(V, _, In) --> {var(V),   in(V, In)}, !.
  105. init_var(V, _,  _) --> {nonvar(V)}, !.
  106.  
  107. make_word(C, Off, Tag^(h+Off)) :- compound(C), !, termtag(C, Tag).
  108. make_word(V,   _, V)           :- var(V), !.
  109. make_word(A,   _, tatm^A)      :- atomic(A), !.
  110.  
  111. % Calculate the size of T on the heap:
  112. size(T) --> {structure(T)}, !, {functor(T, _, N)}, add(1), add(N), size_args(1, N, T).
  113. size(T) --> {cons(T)}, !, add(2), size_args(1, 2, T).
  114. size(T) --> {atomic(T)}, !.
  115. size(T) --> {var(T)}, !.
  116.  
  117. size_args(I, N, _) -->  {I>N}, !.
  118. size_args(I, N, T) --> {I=<N}, !, {arg(I, T, A)}, size(A), {I1 is I+1}, size_args(I1, N, T).
  119.  
  120. %**** Utility routines:
  121.  
  122. add(I, X, Y) :- Y is X+I.
  123.  
  124. in(A, [B|S]) :-
  125.         compare(Order, A, B),
  126.         in_2(Order, A, S).
  127.  
  128. in_2(=, _, _).
  129. in_2(>, A, S) :- in(A, S).
  130.  
  131. incl(A, S1, S) :- incl_2(S1, A, S).
  132.  
  133. incl_2([], A, [A]).
  134. incl_2([B|S1], A, S) :-
  135.         compare(Order, A, B),
  136.         incl_3(Order, A, B, S1, S).
  137.  
  138. incl_3(<, A, B, S1, [A,B|S1]).
  139. incl_3(=, _, B, S1, [B|S1]).
  140. incl_3(>, A, B, S1, [B|S]) :- incl_2(S1, A, S).
  141.  
  142. compound(X)  :- nonvar(X), \+atomic(X).
  143. cons(X)      :- nonvar(X), X=[_|_].
  144. structure(X) :- compound(X), \+X=[_|_].
  145.  
  146. termtag(T, tstr) :- structure(T).
  147. termtag(T, tlst) :- cons(T).
  148. termtag(T, tatm) :- atomic(T).
  149. termtag(T, tvar) :- var(T).
  150.